home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / SCHEME / GNU / SCM4E1 / !Scm / scm / pi < prev    next >
Text File  |  1993-10-27  |  3KB  |  85 lines
  1. ;;;; "pi.scm", program for computing digits of numerical value of PI.
  2. ;;; Copyright (C) 1991 Aubrey Jaffer.
  3. ;;; See the file `COPYING' for terms applying to this program.
  4.  
  5. ;;; (pi <n> <d>) prints out <n> digits of pi in groups of <d> digits.
  6.  
  7. ;;; 'Spigot' algorithm origionally due to Stanly Rabinowitz.
  8. ;;; This algorithm takes time proportional to the square of <n>/<d>.
  9. ;;; This fact can make comparisons of computational speed between systems
  10. ;;; of vastly differring performances quicker and more accurate.
  11.  
  12. ;;; Try (pi 100 5)
  13. ;;; The digit size <d> will have to be reduced for larger <n> or an
  14. ;;; overflow error will occur (on systems lacking bignums).
  15.  
  16. ;;; It your Scheme has bignums try (pi 1000).
  17.  
  18. (define (pi n  . args)
  19.   (if (null? args) (bigpi n)
  20.       (let* ((d (car args))
  21.          (r (do ((s 1 (* 10 s))
  22.              (i 0 (+ 1 i)))
  23.             ((>= i d) s)))
  24.          (n (+ (quotient n d) 1))
  25.          (m (quotient (* n d 3322) 1000))
  26.          (a (make-vector (+ 1 m) 2)))
  27.     (vector-set! a m 4)
  28.     (do ((j 1 (+ 1 j))
  29.          (q 0 0)
  30.          (b 2 (remainder q r)))
  31.         ((> j n))
  32.       (do ((k m (- k 1)))
  33.           ((zero? k))
  34.         (set! q (+ q (* (vector-ref a k) r)))
  35.         (let ((t (+ 1 (* 2 k))))
  36.           (vector-set! a k (remainder q t))
  37.           (set! q (* k (quotient q t)))))
  38.       (let ((s (number->string (+ b (quotient q r)))))
  39.         (do ((l (string-length s) (+ 1 l)))
  40.         ((>= l d) (display s))
  41.           (display #\0)))
  42.       (if (zero? (modulo j 10)) (newline) (display #\ )))
  43.     (newline))))
  44.  
  45. ;;; "bigpi.scm", program for computing digits of numerical value of PI.
  46. ;;; Copyright (C) 1993 Jerry D. Hedden
  47. ;;; See the file `COPYING' for terms applying to this program.
  48.  
  49. ;;; (pi <n>) prints out <n> digits of pi.
  50.  
  51. ;;; 'Spigot' algorithm originally due to Stanly Rabinowitz:
  52. ;;;
  53. ;;; PI = 2+(1/3)*(2+(2/5)*(2+(3/7)*(2+ ... *(2+(k/(2k+1))*(4)) ... )))
  54. ;;;
  55. ;;; where 'k' is approximately equal to the desired precision of 'n'
  56. ;;; places times 'log2(10)'.
  57. ;;;
  58. ;;; This version takes advantage of "bignums" in SCM to compute all
  59. ;;; of the requested digits in one pass!  Basically, it calculates
  60. ;;; the truncated portion of (PI * 10^n), and then displays it in a
  61. ;;; nice format.
  62.  
  63. (define (bigpi digits)
  64.   (let* ((n (* 10 (quotient (+ digits 9) 10)))    ; digits in multiples of 10
  65.      (q (do ((x 2 (* 10000000000 x))    ; q = 2 * 10^n
  66.          (i 0 (+ 1 i)))
  67.         ((>= i (/ n 10)) x)))
  68.      (_pi (+ q q))                ; _pi = result variable
  69.      (z (inexact->exact (truncate (/ (* n (log 10)) (log 2))))))
  70.                         ; z = number of iterations
  71.       ; do the calculations in one pass!!!
  72.       (do ((j     z     (- j 1))
  73.        (k (+ z z 1) (- k 2)))
  74.       ((zero? j))
  75.       (set! _pi (+ q (quotient (* _pi j) k))))
  76.       ; print out the result
  77.       (set! _pi (number->string _pi))            ; _pi = PI * 10^n
  78.       (display (substring _pi 0 1)) (display #\.)    ; displays "3."
  79.       (newline)
  80.       (do ((i 0 (+ i 10)))                ; groups of 10 digits
  81.       ((>= i n))                    ;   5 groups per line
  82.       (display (substring _pi (+ i 1) (+ i 11)))
  83.       (display (if (zero? (modulo (+ i 10) 50)) #\newline #\ )))
  84.       (if (not (zero? (modulo n 50))) (newline))))
  85.